Antecedentes
source('code/antecedentes.R')## `summarise()` has grouped output by 'edad'. You can override using the
## `.groups` argument.
## New names:Variacion Interanual
Tasa básica pasiva
### Poblaciones #### Tasas de mortalidad
Esperanzas al nacer
Empleados de la empresa ABC
Primer ejercicio
Punto A
tablas_activos <- proyeccion_demografica_activos(base_empleados, tablas_supen)llamamos es script con los gráficos.
source('code/graficos_activos.R')fig_activos_vivosPunto B
Punto C
fig_activos_muertosPunto D
Punto E
Para esta sección, se toman las proyecciones demográficas ya hechas anteriormente.
En primer lugar, creamos las tablas en cuestión que nos ayudarán a graficar.
tabla_proy_fin <- proyeccion_financiera(tablas_activos, inflacion = 0.03)Punto F
Punto G
Punto H
Estas son las primas para cada empleado tasa tomando en cuenta la inflación por medio de la ecuación de Fisher (1+i) = (1+tasa_real)(1+inflación), en este caso 0.0712 utilizando 0.04 tasa real y 0.03 de la inflación.
#Primas para empleados
Primas<-Calcula_prima_individuales(base_empleados,tablas_supen,5000000,1000000,300000,0.04)
#Base de empleados de combinaciones únicas
base_unicas<- unico(base_empleados)
#Primas para empleados, Hombre o Mujer y su respectiva edad
Primas_unicas <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.04)
Primas_unicas <- Primas_unicas%>%
mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
select(-c(`Empleado`,`anualidad`,`beneficios`))Punto I
Para la prima nivelada, se toman la suma de las esperanzas de los beneficios futuros y se divide por la suma de las esperanza del valor presente de las primas futuras, dando como resultado la prima nivelada anual.
## [1] 1252880
Punto J
Dado que la idea de este ejercicio es reducir las primas un 10%, calculo cuál es la suma que representa el 90% de las primas originales, para acercarnos a ellas.
#Calcula cuánto es el 90% de las primas obtenidas
Primas_90_porciento <- data.frame(Empleado = Primas$Empleado,
Menos_10_porciento = (Primas$Primas)*0.9)La primera alternativa para reducir la prima 10%:
# Se calculan primas con:
# Suma asegurada de 5 millones durante el tiempo de ser empleado activo
# Suma asegurada de 5 millones durante pensión
# Primer año de pensión con mensualidad de 266.520 colones
Primas1_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,5000000,5000000,266520,0.04)
#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica1_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento,
editada = Primas1_menos_10$Primas,
porcentaje= (Primas1_menos_10$Primas / Primas$Primas) * 100)
#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica1_90_porciento$porcentaje)/nrow(Verifica1_90_porciento))## [1] 90.05992La Segunda alternativa para reducir la prima 10%:
# Se calculan primas con:
# Suma asegurada de 1 millón durante el tiempo de ser empleado activo
# Suma asegurada de 1 millón durante pensión
# Primer año de pensión con mensualidad de 271.900 colones
Primas2_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,1000000,1000000,271900,0.04)
#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica2_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento,
editada = Primas2_menos_10$Primas,
porcentaje= (Primas2_menos_10$Primas / Primas$Primas) * 100)
#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica2_90_porciento$porcentaje)/nrow(Verifica2_90_porciento))## [1] 90.02407#Primas para empleados, Hombre o Mujer y su respectiva edad
Primas_unicas_0.05 <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.05)
Primas_unicas_0.05 <- Primas_unicas_0.05%>%
mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
select(-c(`Empleado`,`anualidad`,`beneficios`))
tabla_para_graficar_distinta_tasa <- data.frame( sexo = Primas_unicas$Sexo,
edad = Primas_unicas$Edad,
primas_normales = Primas_unicas$Primas,
primas_tasa_aumentada = Primas_unicas_0.05$Primas,
variación = (Primas_unicas_0.05$Primas-Primas_unicas$Primas)/Primas_unicas$Primas )
tabla_distinta_tasa_hombres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Hombre", ]
tabla_distinta_tasa_mujeres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Mujer", ]Modelo estocástico
El siguiente chunck puede ejecutar las simulaciones, pero para efectos del informe, se tienen los valores guardados en un csv El mismo corre 100.000 simulaciones, en aproximadamente 3,5 minutos
primas_modelo_estocastico <- realizar_simulaciones(base_empleados, 100000, 0.04)Se importan los resultados de las simulaciones
simulaciones <- read_csv('docs/primas_cuartiles_t.csv')## Rows: 90 Columns: 2
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (2): 50%, 90%
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.combinaciones_unicas <- base_empleados %>%
arrange(edad, sexo) %>%
select(edad, sexo) %>%
distinct()resultados <- cbind(combinaciones_unicas, simulaciones)
colnames(resultados) <- c('Edad', 'Sexo', 'Cuartil 50', 'Cuartil 90')
resultados_hombres <- subset(resultados, Sexo == '1') %>% select(-Sexo)
resultados_mujeres <- subset(resultados, Sexo == '2') %>% select(-Sexo)Resultados de las primas para hombres
resultados_hombres## Edad Cuartil 50 Cuartil 90
## 1 20 702279.8 857664.2
## 3 21 732845.2 894992.5
## 5 22 746901.2 922918.4
## 7 23 779819.6 963594.4
## 9 24 814429.3 1006360.3
## 11 25 850846.4 1051359.7
## 13 26 889198.6 1098750.0
## 15 27 929626.2 1148704.9
## 17 28 972284.4 1201416.1
## 19 29 1017345.0 1257095.9
## 21 30 1064999.1 1315980.3
## 23 31 1115459.6 1378332.5
## 25 32 1139611.5 1444446.8
## 27 33 1195002.0 1514653.7
## 29 34 1253915.3 1589325.8
## 31 35 1316684.1 1668884.7
## 33 36 1383686.5 1731549.0
## 35 37 1455354.0 1821233.9
## 37 38 1532181.9 1917376.5
## 39 39 1614740.9 2020691.1
## 41 40 1703693.1 2132006.0
## 43 41 1799810.2 2252287.2
## 45 42 1903998.1 2382668.3
## 47 43 1963288.0 2524488.5
## 49 44 2141071.3 2679342.3
## 51 45 2215770.6 2849142.7
## 53 46 2361248.8 3036205.3
## 55 47 2522353.0 3243360.8
## 57 48 2701802.8 3474105.7
## 59 49 2902997.5 3732811.5
## 61 50 3130243.8 4025015.5
## 63 51 3389079.0 4357838.1
## 65 52 3686745.3 4677209.3
## 67 53 4032899.9 5116360.1
## 69 54 4440712.7 5633734.0
## 71 55 4928623.2 6252724.3
## 73 56 5523268.4 7007124.1
## 75 57 6264605.6 7947625.5
## 77 58 7215428.1 9153891.7
## 79 59 8480395.1 10758698.8
## 81 60 10247897.5 13001050.1
## 83 61 12894723.4 16358960.1
## 85 62 17300054.0 21947806.4
## 87 63 26101446.4 33113740.0
## 89 64 52486714.3 66587551.8Resultados de las primas para mujeres
resultados_mujeres## Edad Cuartil 50 Cuartil 90
## 2 20 762378.4 867607.7
## 4 21 795559.4 905368.7
## 6 22 830395.2 945012.7
## 8 23 866993.4 986662.5
## 10 24 888663.1 1030452.2
## 12 25 928399.6 1076528.8
## 14 26 970247.4 1125053.7
## 16 27 1014360.0 1176204.5
## 18 28 1060906.4 1230177.6
## 20 29 1110074.3 1287190.3
## 22 30 1162071.9 1347484.4
## 24 31 1217131.8 1411329.3
## 26 32 1275513.8 1479026.3
## 28 33 1337509.8 1533139.3
## 30 34 1403448.7 1608722.7
## 32 35 1444713.0 1689252.6
## 34 36 1518230.4 1775213.9
## 36 37 1596866.6 1867160.5
## 38 38 1681164.8 1965727.5
## 40 39 1771751.6 2071647.5
## 42 40 1869353.1 2185769.5
## 44 41 1974816.2 2309083.8
## 46 42 2089134.9 2442752.7
## 48 43 2213483.6 2588149.3
## 50 44 2349260.1 2746908.1
## 52 45 2450980.4 2920990.3
## 54 46 2606603.0 3112770.2
## 56 47 2784447.4 3325149.6
## 58 48 2982543.6 3561713.3
## 60 49 3204644.2 3826942.9
## 62 50 3455503.3 4126515.5
## 64 51 3741233.8 4467731.0
## 66 52 4069830.3 4801536.0
## 68 53 4451953.3 5252360.0
## 70 54 4902141.4 5783486.4
## 72 55 5440750.1 6418930.4
## 74 56 6097184.0 7193383.1
## 76 57 6915552.6 8158884.4
## 78 58 7965173.9 9397214.8
## 80 59 9154071.2 11044679.9
## 82 60 11061982.6 13346636.0
## 84 61 13919070.4 16793803.9
## 86 62 18674357.1 22531209.5
## 88 63 28174925.4 33993949.1
## 90 64 56656218.8 68357541.1